( )( FMODEM --- Words for transfering screens between computers )( that have RS232 ports. )( )( Ward Christensens protocol for data transfer via modem has )( been followed as closely as the information I have would )( allow. This version of FMODEM implements the Checksum method )( of data verification. CRC and possibly ECC versions will be )( explored in the near future. )( )( )( Please put these routines on your machine and try them out. )( )( July 1983 Zane Thomas )--> ( PO Box 618 )( Silverado, Ca. )( 92676-0618 ) BASE @ HEX ( ************************************************************ )( ************* HARDWARE DEPENDENT DEFINITIONS *************** )( ************************************************************ )( )( You must rewrite the following definitions in order to use )( the transfer routines contained herein. ) FFFE24 CONSTANT PORT ( Address of serial port on my machine)PORT CONSTANT STATUS ( Status register )--> PORT CONSTANT COMMAND ( Command register )PORT 2+ CONSTANT TX_DATA ( Transmitt data register )PORT 2+ CONSTANT RX_DATA ( Receive data register ) 02 CONSTANT TX_RDY ( Transmitter empty status mask ) 01 CONSTANT RX_RDY ( Receiver full status mask ) 4 CONSTANT B/W ( Bytes per word. Probably 2 on your ) ( machine. ) ( Receive character ready? Leave True or False on stack ): RX_RDY? ( --- non-zero or false ) STATUS C@ RX_RDY AND ; ( Transmitter empty? Leave True or False on stack ): TX_RDY? ( --- non-zero or false )--> STATUS C@ TX_RDY AND ; ( Put contents of receive data register on stack ): RX_CHAR ( --- char ) RX_DATA C@ ; ( Wait for transmitt register empty then put top of stack in it): TX_CHAR ( char --- ) BEGIN TX_RDY? UNTIL TX_DATA C! ; ( Wait .001 seconds. +-10% should be just fine ): .001SEC_DELAY 40 0 DO LOOP ; ( Put all your serial port and modem initialization code here )--> : INIT_ROUTINE 15 COMMAND C! ; ( ************************************************************ )( *********** END OF HARDWARE DEPENDENT DEFINITIONS ********** )( ************************************************************ )( )( If you have fig-Forth the rest should be easy. ) 1B CONSTANT ESCAPE ( Ascii ESCape )12 CONSTANT ^R ( Control R ) 6 CONSTANT ACK ( ACKnowledge )15 CONSTANT NAK ( Negative AcKnowledge ) 1 CONSTANT SOH ( Start Of Header ) 4 CONSTANT EOT ( End Of Transfer )--> 0 CONSTANT FALSE ( boolean false ) 1 CONSTANT TRUE ( boolean true [ aka any non zero value ] ) DECIMAL 128 CONSTANT REC_SIZ ( number of bytes per record ) 0 VARIABLE REC_BUF REC_SIZ B/W - ALLOT ( buffer for 1 record ) 0 VARIABLE EOT_FLAG ( used to avoid some really nasty nesting) 0 VARIABLE REC# ( record # to be received or transmitted ) ( this is a byte value. The first record ) ( of a series of transfers is numbered 1.) ( subsequent transfers increment record #) 0 VARIABLE #ERRS ( number of errors during CURRENT record ) 0 VARIABLE #SECONDS ( number of seconds to wait for an event )--> 0 VARIABLE LAST_SCR ( highest numbered screen involved in ) ( transfer ) 0 VARIABLE THIS_SCR ( screen currently being transfered ) 0 VARIABLE XFER# ( number of transfers. range 1->word size) 0 VARIABLE CHECK_SUM ( checksum of current record ) 0 VARIABLE AO_MODE ( 1 if answer mode 0 if originate mode ) ( in answer mode word TALK will echo ) ( received characters ) 10 CONSTANT ERR_LIM ( maximum number of errors per record ) ( transfer aborted if this value is ) ( exceeded ) : NOT 0= ; : ESC? ( char --- true or false )--> ESCAPE = ; : ^R? ( char --- true or false ) ^R = ; : EOT_RECEIVED ( --- ) 1 EOT_FLAG ! ; : EOT_RECEIVED? ( --- true or false ) EOT_FLAG @ ; : ANSWER ( --- ) TRUE AO_MODE ! ; : ORIGINATE ( --- ) FALSE AO_MODE ! ; : ECHO ( char --- char ) AO_MODE @ IF DUP TX_CHAR ENDIF ; ( Abort transfer if maximum number of errors has been exceeded )--> : MAX_ERR_ABORT ( QUITs if #errs>err_lim ) #ERRS @ ERR_LIM > IF CR ." Error count > " ERR_LIM . ." transfer aborted!" CR 7 EMIT QUIT ENDIF ; ( Aborts transfer if an unexpected record # was received ): SYNC_ABORT ( unexpected REC# ... QUITs ) CR ." Loss of sync...transfer aborted!" CR 7 EMIT QUIT ; ( Wait for a character for amount of time in #seconds )( if received leave it under a true on stack else if timed out )( leave a false on stack. )--> ( Increments #errs if timeout occurs. ): RX_CHAR ( --- char,true or false ) FALSE #SECONDS @ 900 * 0 DO .001SEC_DELAY RX_RDY? IF DROP RX_CHAR TRUE LEAVE ENDIF LOOP DUP 0= IF 1 #ERRS +! ENDIF ; ( ************************************************************ )( ***************** START OF RECEIVER WORDS ****************** )( ************************************************************ ) ( Trashes incoming characters ... used when a transfer has been)( determined to be in error. The transmitter may not be done at)( the time the determination is made ): PURGE ( trash incoming characters ) --> 1 #SECONDS ! BEGIN RX_CHAR WHILE DROP REPEAT -1 #ERRS +! ; ( Send an ACKnowledge to the transmitter. Informs transmitter )( that previous record was recieved without error. ): SEND_ACK ( --- ) ACK TX_CHAR ; ( Purge line and send Negative AcKnowledge to transmitter. )( Informs transmitter that the previous record was not received)( well. The transmitter will retransmitt if it's error count )( for the current record is less than 10 ): SEND_NAK ( --- ) PURGE NAK TX_CHAR ; ( Transfer a record from rec_buf to this_screen )--> : 128>SCR ( --- ) REC_BUF XFER# @ 1 - 8 MOD DUP 0= IF 1 THIS_SCR +! ENDIF 128 * THIS_SCR @ BLOCK + REC_SIZ CMOVE UPDATE ; ( Receives 128 bytes and accumulates a checksum for the bytes )( Receives check sum from remote and checks it. Leaves a TRUE )( if the block is ok. ): RX_128 ( --- true or false ) 0 R# ! 0 CHECK_SUM ! 1 #SECONDS ! BEGIN RX_CHAR IF DUP CHECK_SUM +! REC_BUF R# @ + C! 1 R# +! FALSE ELSE TRUE ENDIF --> R# @ REC_SIZ = OR UNTIL ( until timeout error or rec_siz bytes received ) R# @ REC_SIZ = NOT IF FALSE ( leave false if timeout error ) ELSE RX_CHAR ( else wait for checksum ) IF CHECK_SUM @ 255 AND = ( leave true or false ) ELSE FALSE ENDIF ENDIF ; ( leaves TRUE if record# received and record# = expected ) ( leaves TRUE if record# received and record# = expected-1 ) ( if TRUE is to be left on stack REC# and XFER# are adjusted ) ( either up or down depending upon incoming record # ) ( [ record # = expected-1 if last ACK was corrupted to ) ( a NAK. ] ) --> : RX_REC# ( --- TRUE or FALSE ) RX_CHAR IF RX_CHAR IF 255 XOR SWAP OVER = IF REC# @ OVER 1+ OVER = IF DROP REC# ! TRUE -1 XFER# +! ELSE OVER OVER = IF REC# ! DROP TRUE 1 XFER# +! ELSE SYNC_ABORT ENDIF ENDIF ELSE DROP 1 #ERRS +! FALSE ENDIF ELSE FALSE ENDIF ELSE FALSE ENDIF ; ( three terminating conditions for this loop: ) --> ( EOT received ) ( Valid header received ) ( #ERRS > max_errors ... QUITs via MAX_ERR_ABORT ) : GET_HEADER ( --- ) 10 #SECONDS ! BEGIN RX_CHAR IF DUP SOH = IF DROP 1 #SECONDS ! ( change timeout when SOH rcvd) RX_REC# DUP 0= IF SEND_NAK ENDIF ELSE EOT = IF EOT_RECEIVED TRUE ELSE SEND_NAK 1 #ERRS +! FALSE ENDIF ENDIF ELSE FALSE ENDIF --> MAX_ERR_ABORT UNTIL ; ( Leaves ACK if valid header and data received or if EOT ) ( writes record to SCR pointed to by THIS_SCR ) ( otherwise leaves NAK ) : RX_REC ( --- ACK or NAK ) ." Transfer # " XFER# @ . GET_HEADER EOT_RECEIVED? NOT IF RX_128 IF 128>SCR ACK ." ACK " ELSE NAK ." NAK " ENDIF ELSE ACK ." EOT " ENDIF CR ; --> ( Receives records storing them at this_screen until ) ( EOT received or this_screen > last_screen ) : MODEM>SCREENS ( --- ) THIS_SCR @ BLOCK DROP 1 REC# ! 0 XFER# ! 0 EOT_FLAG ! CR ." READY TO RECIEVE " CR SEND_NAK BEGIN RX_REC 1 REC# +! 0 #ERRS ! EOT_RECEIVED? THIS_SCR @ LAST_SCR @ > OR SWAP TX_CHAR ( send ACK or NAK ) UNTIL SEND_ACK UPDATE FLUSH CR ." TRANSFER COMPLETE" CR ; --> ( ************************************************************ )( *************** START OF TRANSMITTER WORDS ***************** )( ************************************************************ ) : READ_128 ( --- buffer address ) XFER# @ 1 - 8 MOD DUP 0= IF 1 THIS_SCR +! ENDIF 128 * THIS_SCR @ BLOCK + ; : TX_128 ( --- ) READ_128 0 R# ! 0 CHECK_SUM ! 128 0 DO I OVER + C@ DUP TX_CHAR CHECK_SUM +! LOOP DROP CHECK_SUM @ 255 AND TX_CHAR ; --> : TX_HEADER SOH TX_CHAR XFER# @ 255 AND DUP TX_CHAR 255 XOR TX_CHAR ; : TX_REC ." Transfer # " XFER# @ . TX_HEADER TX_128 BEGIN RX_CHAR IF ACK = ELSE FALSE ." TIMEOUT" ENDIF IF 1 XFER# +! ." ACK " TRUE ELSE XFER# @ 1 - 8 MOD 0= IF -1 THIS_SCR +! ENDIF 1 #ERRS +! ." NAK " TX_HEADER TX_128 FALSE ENDIF MAX_ERR_ABORT UNTIL CR ; : WAIT_FOR_1ST_NAK --> 0 #ERRS ! 60 #SECONDS ! BEGIN MAX_ERR_ABORT RX_CHAR IF NAK = DUP 0= IF 1 #ERRS +! ENDIF ELSE 1 #ERRS +! FALSE ENDIF UNTIL ; : WAIT_FOR_LAST_ACK 0 #ERRS ! BEGIN MAX_ERR_ABORT EOT TX_CHAR RX_CHAR IF ACK = DUP 0= IF 1 #ERRS +! ENDIF ELSE 1 #ERRS +! FALSE ENDIF UNTIL ; --> : SCREENS>MODEM 0 #ERRS ! THIS_SCR @ BLOCK DROP 1 XFER# ! CR ." READY TO SEND " CR WAIT_FOR_1ST_NAK 10 #SECONDS ! BEGIN ?TERMINAL IF QUIT ENDIF 0 #ERRS ! TX_REC THIS_SCR @ LAST_SCR @ = UNTIL WAIT_FOR_LAST_ACK CR ." TRANSFER COMPLETE" CR ; --> ( ************************************************************ )( ********************* FMODEM and TALK ********************** )( ************************************************************ ) ( allows you to talk to the remote system prior to start of a )( transfer )( KILLCC used in talk is needed for my operating system. )( Take it out. ): TALK CR ." Terminal mode" CR ." Press the [esc] key to get back to Forth." CR CR BEGIN ?KEY IF KEY KILLCC DUP ESC? NOT IF TX_CHAR 0 --> ELSE DUP ENDIF ELSE 0 ENDIF RX_RDY? IF RX_CHAR DROP ECHO EMIT ENDIF UNTIL CR CR ." Enter SCREENS>MODEM to transmit screens." CR ." Enter MODEM>SCREENS to receive screens." CR CR ; ( very primitive word at this point ... bumper sticker for ) ( the day " SO MANY WORDS ... SO LITTLE TIME " ) : FMODEM ( start scr, maximum screens --- ) --> OVER + LAST_SCR ! 1 - THIS_SCR ! CR CR ." FMODEM July 20,1983" CR
